home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / usenet / st80_pre4 / BDFtoStrikefont2.st < prev    next >
Text File  |  1993-07-24  |  10KB  |  282 lines
  1. "    NAME        BDFtoStrikefont2
  2.     AUTHOR        eliot@cs.qmw.ac.uk (Eliot Miranda)
  3.     FUNCTION creates Smalltalk StrikeFonts from X BDF files
  4.     ST-VERSIONS    2.3
  5.     PREREQUISITES     
  6.     CONFLICTS    
  7.     DISTRIBUTION      world
  8.     VERSION        1.1
  9.     DATE    16 Aug 90
  10. SUMMARY    creates Smalltalk StrikeFonts from X BDF files.
  11.  
  12. Newsgroups: comp.lang.smalltalk
  13. Message-ID: <2659@sequent.cs.qmw.ac.uk>
  14. Date: 16 Aug 90 11:39:14 GMT
  15. References: <646@argosy.UUCP>
  16.  
  17. Eliot Miranda            email:    eliot@cs.qmw.ac.uk
  18. Dept of Computer Science    Tel:    071 975 5220 (+44 71 975 5220)
  19. Queen Mary Westfield College    ARPA:    eliot%cs.qmw.ac.uk@nsfnet-relay.ac.uk
  20. Mile End Road            UUCP:    eliot@qmw-cs.uucp
  21. LONDON E1 4NS
  22. "
  23. !
  24.  
  25. 'From BrouHaHa Smalltalk-80, Version 2.3.1 of 30 January 1989 on 8 January 1990 at 2:30:38 pm'!
  26.  
  27.  
  28.  
  29. !PositionableStream methodsFor: 'accessing'!
  30.  
  31. upToAny: aCollection 
  32.     "Answer a subcollection from position to the occurrence (if any, not  
  33.     inclusive) of any element in aCollection. If not there, answer everything."
  34.  
  35.     | newStream element |
  36.     newStream _ WriteStream on: (collection species new: 64).
  37.     [self atEnd or: [aCollection includes: (element _ self next)]]
  38.         whileFalse: [newStream nextPut: element].
  39.     ^newStream contents! !
  40.  
  41. !TextStyle methodsFor: 'accessing'!
  42.  
  43. outputMedium: aSymbol
  44.     "Set the outputMedium for this style -- currently only Display"
  45.     outputMedium _ aSymbol.
  46.     lineGrid == nil ifTrue: [lineGrid _ DefaultLineGrid].
  47.     baseline == nil ifTrue: [baseline _ DefaultBaseline]"! !
  48.  
  49. !TextStyle methodsFor: 'private'!
  50.  
  51. newFontArray: anArray
  52.     fontArray _ anArray.
  53.     lineGrid _ (fontArray inject: 0 into: [:h :f| h max: f height]).
  54.     baseline _ (fontArray inject: 0 into: [:h :f| h max: f ascent]) - 1.
  55.     alignment _ 0.
  56.     firstIndent _ 0.
  57.     restIndent _ 0.
  58.     rightIndent _ 0.
  59.     outputMedium _ #Display.
  60.     tabsArray _ DefaultTabsArray.
  61.     marginTabsArray _ DefaultMarginTabsArray
  62.  
  63.     "Currently there is no supporting protocol for changing these arrays.  If an editor wishes to implement margin setting, then a copy of the default should be stored as these instance variables."! !
  64.  
  65.  
  66. !TextStyle class methodsFor: 'instance creation'!
  67.  
  68. createBDFStyle: fileNames named: styleName
  69.     | array |
  70.     array _ fileNames asArray collect: [:fn| | fs sf |
  71.                     (fs _ FileStream oldFileNamed: fn) readOnly.
  72.                     sf _ StrikeFont fromBDFFile: fs.
  73.                     fs close.
  74.                     sf].
  75.     "Add a copy of the fonts on the end with underlined emphasis"
  76.     array _ array, (array collect: [:f| f copy emphasis: 4. "underlined"]).
  77.  
  78.     self styleNamed: styleName asSymbol put: (self fontArray: array)
  79.  
  80.  
  81.  
  82.     "TextStyle
  83.         createBDFStyle: (
  84.             #(    'timR18' 'timB18' 'timI18'
  85.                 'helvR18' 'helvB18' 'helvO18'
  86.                 'timR24' 'timB24' 'timI24'
  87.                 'helvR24' 'helvB24' 'helvO24' ) collect: [:n|
  88.                     '/nfs/whistle/pub/X.V11R3/core.src/fonts/bdf/75dpi/', n, '.bdf'])
  89.         named: #BDFLarge"
  90.  
  91.  
  92.     "TextStyle
  93.         createBDFStyle: (
  94.             #(    'courR10' 'courB10' 'courO10'
  95.                 'courR12' 'courB12' 'courO12'
  96.                 'courR14' 'courB14' 'courO14'
  97.                 'courR18' 'courB18' 'courO18' ) collect: [:n|
  98.                     '/nfs/whistle/pub/X.V11R3/core.src/fonts/bdf/75dpi/', n, '.bdf'])
  99.         named: #BDFFixed.
  100.     1 to: 12 do: [:n|
  101.         | font |
  102.         font _ (TextStyle styleNamed: #BDFFixed) fontAt: n.
  103.         font fixPitch scrunch.
  104.         n > 3 ifTrue: [font scrunch]]"! !
  105.  
  106.  
  107. !Document methodsFor: 'Smalltalk compatibility'!
  108.  
  109. getFontLike: familySizeFace 
  110.     "Map a strike font to an abstract type family."
  111.  
  112.     | family |
  113.     family _ familySizeFace at: 1.
  114.     (#('TIMES' 'TIMESROMAN' 'SERIF') includes: family)
  115.         ifTrue: [^#Serif].
  116.     (#('HELVETICA' 'SANSERIF' 'SANS-SERIF') includes: family)
  117.         ifTrue: [^#SanSerif].
  118.     (#('FIXED' 'ICON' 'COURIER') includes: family)
  119.         ifTrue: [^#FixedPitch].
  120.     self error: 'don''t know how to handle this font yet!!'! !
  121.  
  122.  
  123. !Character methodsFor: 'accessing'!
  124.  
  125. digitValue
  126.     "Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0 otherwise.
  127.     This is used to parse literal numbers of radix 2-36."
  128.  
  129.     value <= $9 asciiValue 
  130.         ifTrue: [^value - $0 asciiValue].
  131.     value >= $A asciiValue 
  132.         ifTrue: [
  133.             value <= $Z asciiValue ifTrue: [^value - $A asciiValue + 10].
  134.             value >= $a asciiValue ifTrue: [
  135.                 value <= $z asciiValue ifTrue: [^value - $a asciiValue + 10]]].
  136.     ^-1! !
  137.  
  138.  
  139. !StrikeFont methodsFor: 'private'!
  140.  
  141. setFromBDFFile: stream
  142.     "Create a StrikeFont from an X11 style Bitmap Distribution Format file.
  143.      See /usr/X11/core.src/doc/bdf/bdf.mss"
  144.  
  145.     | token space cr separators blitter byteStripe glyph min max bold italic |
  146.  
  147.     bold _ italic _ false.
  148.     stopConditions _ Array new: 258 withAll: #characterNotInFont.
  149.     xTable _ Array new: 258 withAll: 0.
  150.     minAscii _ 0. maxAscii _ 255.
  151.     min _ 256. max _ -1. maxWidth _ 0.
  152.     byteStripe _ Form extent: 1024@1.
  153.     byteStripe bits: (ByteArray new: 1024 / 8).
  154.     glyph _ Form extent: 0@0.
  155.     blitter _ BitBlt
  156.                 destForm: glyph sourceForm: byteStripe halftoneForm: nil combinationRule: Form over
  157.                 destOrigin: 0@0 sourceOrigin: 0@0 extent: 0@1 clipRect: (0@0 extent: 0@0). 
  158.  
  159.     space _ Character space.
  160.     cr _ Character cr.
  161.     separators _ Array with: space with: cr.
  162.     [stream atEnd] whileFalse: [
  163.         token _ stream upToAny: separators.
  164.         token = 'STARTPROPERTIES' ifTrue: [
  165.             [    stream skip: -1; skipTo: cr.
  166.                 token _ stream upToAny: separators.
  167.                 token = 'FONT_ASCENT'    ifTrue: [ascent _ Integer readFrom: stream].
  168.                 token = 'FONT_DESCENT'    ifTrue: [descent _ Integer readFrom: stream].
  169.                 token = 'FAMILY_NAME' ifTrue: [stream skipTo: $". name _ stream upTo: $"].
  170.                 token = 'WEIGHT_NAME' ifTrue: [stream skipTo: $". bold _ stream peek = $B].
  171.                 token = 'SLANT' ifTrue: [stream skipTo: $". italic _ stream peek == $I or: [stream peek == $O]].
  172.                 token = 'PIXEL_SIZE' ifTrue: [name _ name, (stream upToAny: separators)].
  173.                 token ~= 'ENDPROPERTIES'] whileTrue.
  174.             glyphs _ Form extent: 0@ascent + descent.
  175.             blitter clipHeight: ascent + descent].
  176.  
  177.         token = 'STARTCHAR' ifTrue: [
  178.             | ascii charWidth w h ox oy bytes |
  179.             stream skip: -1; skipTo: cr.
  180.             ((token _ stream upToAny: separators) = 'ENCODING'
  181.             and: [(ascii _ Integer readFrom: stream) > 0]) ifTrue: [
  182.                 ascii < min ifTrue: [min _ ascii].
  183.                 ascii > max ifTrue: [max _ ascii].
  184.                 stopConditions at: ascii + 1 put: nil.
  185.                 [    stream skip: -1; skipTo: cr.
  186.                     token _ stream upToAny: separators.
  187.                     token = 'DWIDTH' ifTrue: [charWidth _ Integer readFrom: stream].
  188.                     token = 'BBX' ifTrue: [
  189.                         w _ Integer readFrom: stream. stream skip: 1.
  190.                         h _ Integer readFrom: stream. stream skip: 1.
  191.                         ox _ Integer readFrom: stream. stream skip: 1.
  192.                         oy _ Integer readFrom: stream.
  193.                         glyph extent: (w + 1 max: charWidth) @ glyphs height; white.
  194.                         maxWidth < glyph width ifTrue: [maxWidth _ glyph width].
  195.                         blitter width: w; clipWidth: w].
  196.                     token = 'BITMAP' ifTrue: [
  197.                         stream skip: -1; skipTo: cr.
  198.                         0 to: h - 1 do: [:y| | line |
  199.                             line _ stream upTo: cr.
  200.                             1 to: line size by: 2 do: [:i|
  201.                                 byteStripe bits
  202.                                     at: i + 1 / 2
  203.                                     put: (line at: i) digitValue * 16 + (line at: i + 1) digitValue].
  204.                             blitter destY: ascent - h - oy + y; copyBits].
  205.                         glyph display.
  206.                         self characterFormAt: (Character value: ascii) put: glyph.
  207.                         ascii = 171 ifTrue: [
  208.                             self characterFormAt: $_ put: glyph]].
  209.                     token ~= 'ENDCHAR'] whileTrue]].
  210.         stream skip: -1; skipTo: cr].
  211.  
  212.     emphasis _ strikeLength _ xOffset _ 0.
  213.     raster _ glyphs raster.
  214.     superscript _ ascent - descent // 3.    
  215.     subscript _ descent - ascent // 3.
  216.     minAscii _ min.
  217.     maxAscii _ max.
  218.     bold ifTrue: [name _ name, 'b'].
  219.     italic ifTrue: [name _ name, 'i']! !
  220.  
  221.  
  222. !StrikeFont class methodsFor: 'instance creation'!
  223.  
  224. fromBDFFile: stream
  225.     ^self new setFromBDFFile: stream! !
  226.  
  227.  
  228. !CharacterScanner methodsFor: 'scanning'!
  229.  
  230. characterNotInFont
  231.     "All fonts have an illegal character to be used when a character is  
  232.     not within the font's legal range.  When characters out of ranged 
  233.     are encountered in scanning text, then this special character 
  234.     indicates the appropriate behavior.  The character is usually treated 
  235.     as a unary message understood by a subclass of CharacterScanner."
  236.  
  237.     | illegalAsciiString saveIndex stopCondition | 
  238.     saveIndex _ lastIndex.
  239.     illegalAsciiString _ String with: (font maxAscii + 1 min: 255) asCharacter.
  240.     (self isMemberOf: CompositionScanner) not
  241.     ifTrue: [
  242.     stopCondition _ self scanCharactersFrom: 1
  243.                         to: 1
  244.                         in: illegalAsciiString
  245.                         rightX: rightMargin
  246.                         stopConditions: stopConditions
  247.                         displaying: self doesDisplaying]
  248.     ifFalse:    [
  249.     stopCondition _ 
  250.         self scanCharactersFrom: 1 to: 1
  251.             in: illegalAsciiString
  252.             rightX: rightMargin stopConditions: stopConditions
  253.             displaying: self doesDisplaying].
  254.     lastIndex _ saveIndex + 1.
  255.     stopCondition ~= (stopConditions at: EndOfRun)
  256.         ifTrue:    [^self perform: stopCondition]
  257.         ifFalse: [lastIndex = runStopIndex
  258.                     ifTrue:    [^self perform: (stopConditions at: EndOfRun)].
  259.                 ^false]! !
  260.  
  261.  
  262. !ExternalStream methodsFor: 'nonhomogeneous accessing'!
  263.  
  264. nextSigned
  265.     "Answer the next byte from the receiver as a signed byte."
  266.  
  267.     | value |
  268.     self atEnd ifTrue: [^false].
  269.     ^(value _ self next asInteger) > 127
  270.         ifTrue: [256 + value negated]
  271.         ifFalse: [value]! !
  272.  
  273.  
  274. !CharacterBlockScanner methodsFor: 'scanning'!
  275.  
  276. characterNotInFont
  277.     "This does not handle character selection nicely, i.e., illegal characters are a little tricky to select.  Since the end of a run or line is subverted here by actually having the scanner scan a different string in order to manage the illegal character, things are not in an absolutely correct state for the character location code.  If this becomes too odious in use, logic will be added to accurately manage the situation."
  278.  
  279.     lastCharacterExtent _ 
  280.         (font widthOf: (font maxAscii + 1 min: 255) asCharacter) @ textStyle lineGrid.
  281.     ^super characterNotInFont! !
  282.